home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2009 February / PCWFEB09.iso / Software / Shareware / IDimager Personal 4.2.0.3 / setup_IDimager_Personal_V4.exe / {app} / Scripts / GPS Scripts / Launch Google Earth.psc < prev    next >
Text File  |  2008-10-16  |  13KB  |  375 lines
  1. (*
  2. ' *************************************************************************
  3. ' * Scriptname:
  4. ' *   Launch Google Earth
  5. ' *
  6. ' * Description:
  7. ' *   Creates a KML file using an image's GPS info,
  8. ' *   then opens the file using Windows association.
  9. ' *
  10. ' * Version 1.0b:
  11. ' *   Len Merkel
  12. ' *
  13. ' * 1.0a a small update by Hert to fix international decimal characters
  14. ' * 1.0b Len: Extract thumbnail from image and assign to Placemark > Description
  15. ' *           in KML file
  16. ' * 1.1  Hert: Converted the script to use the new TGPSReadWrite in 4.0.0.5
  17. ' * 1.2  Dirk: added handling of more than 1 selected img
  18. ' * 1.21 Hert: Support for Unicode; files clean-up
  19. ' * 1.22 Hert: The name displayed in Google Earth is now determined by the
  20. ' *            sequence: Headline? No -> Title? No -> FileName. In earlier versions
  21. ' *            that was always the file name.
  22. ' *
  23. ' * Acknowledgements:
  24. ' *   GPS meta data routines (and help) provided by Louis Salkind
  25. ' *
  26. ' * Assumptions:
  27. ' *   Google Earth is associated with KML files
  28. ' *************************************************************************/
  29. *)
  30.  
  31. const
  32.   cFilePrefixID = 'idi_ge_script~';
  33. var
  34.   AGps: TGPSReadWrite;
  35.  
  36. function DirectionLatLon(AVal: Double; AIsLat: Boolean): String;
  37. begin
  38.   if AIsLat then result := iif(AVal >= 0, 'N', 'S') else result := iif(AVal >= 0, 'E', 'W');
  39. end;
  40.  
  41. // set a string value for the property list attribute Name
  42. function UpdateNameValue(AList: TStringList; Name, Value: String): Integer;
  43. var
  44.   idx: Integer;
  45.   keyval: String;
  46.  
  47. begin
  48.   keyval := Name + '=' + Value;
  49.   idx := AList.IndexOfName(Name);
  50.   if idx >= 0 then
  51.     AList.Strings[idx] := keyval
  52.   else
  53.     idx := AList.Add(keyval);
  54.   result := idx;
  55. end;
  56.  
  57. // populate the property list with AImage's metadata
  58. procedure ReadImageInfo(AImage: TImageItem; AList: TStringList)
  59. var
  60.   xxx: Integer;    // XXX avoid trashing stack with call be reference
  61.   ATif: TTif;
  62.   AXmp: TXMP;
  63.   AXmpParam: TMacroParam;
  64.   ATag: TTifTag;
  65.   ALat, ALon, AAlt: Double;
  66.   AAltRef: Integer;
  67.   idx: Integer;
  68.   HasXMP: Boolean;
  69.  
  70. begin
  71.  
  72. //Say('Creating');
  73. //  ImageInfoSetImage(AList, AImage, 'Base');
  74. //Say('Assigning ' + IntToStr(idx) + ' ' + AImage.GUID);
  75.  
  76.   ATif := TTif.Create (nil);
  77.   AXmp := TXMP.Create (False);
  78.   try
  79.     ATif.FileName := AImage.ExifFileName;
  80.     ATif.Load (True, False);
  81.     Catalog.LoadXMPForImage (AImage, AXmp, Options.CachedXMP);
  82.  
  83. //Say('Loaded');
  84.  
  85.     ATag  := ATif.GPSIFD.FindTag ($2);        // latitude
  86.  
  87.     // first try to get the coords from XMP, then from Exif
  88.     AXmpParam := AXmp.XMPDesign.FindIdCommand ('exif', 'exif:GPSLatitude', True);
  89.     HasXMP := False;
  90.     if AXmpParam <> nil then if (Nvl(AXmpParam.ParamContent, '') <> '') then
  91.       HasXMP := True;
  92.     if HasXMP then
  93.     begin
  94.       ALat := AGps.GPSStrToFloat(AXmpParam.ParamContent);
  95.       UpdateNameValue(AList, 'Lat', StrTran (FloatToStr(ALat), DecimalSeparator, '.'));
  96.     end
  97.     else if ATag <> nil then
  98.     begin
  99.       ALat := AGps.ReadGpsPos (ATag);
  100.       ATagRef := ATif.GPSIFD.FindTag ($1);
  101.       if ATagRef.Value <> 'N' then
  102.         ALat := -ALat;
  103.       UpdateNameValue(AList, 'Lat', StrTran (FloatToStr(ALat), DecimalSeparator, '.'));
  104.     end;
  105.  
  106. //Say('After Lat ' + AList.Text);
  107.  
  108.     ATag  := ATif.GPSIFD.FindTag ($4);        // longitude
  109.     AXmpParam := AXmp.XMPDesign.FindIdCommand ('exif', 'exif:GPSLongitude', True);
  110.     HasXMP := False;
  111.     if AXmpParam <> nil then if (Nvl(AXmpParam.ParamContent, '') <> '') then
  112.       HasXMP := True;
  113.     if HasXMP then
  114.     begin
  115.       ALon := AGps.GPSStrToFloat(AXmpParam.ParamContent);
  116.       UpdateNameValue(AList, 'Lon', StrTran (FloatToStr(ALon), DecimalSeparator, '.'));
  117.     end
  118.     else if ATag <> nil then
  119.     begin
  120.       ALon := AGps.ReadGpsPos (ATag);
  121.  
  122.       ATagRef := ATif.GPSIFD.FindTag ($3);
  123.       if ATagRef.Value <> 'E' then
  124.         ALon := -ALon;
  125.       UpdateNameValue(AList, 'Lon', StrTran (FloatToStr(ALon), DecimalSeparator, '.'));
  126.     end;
  127.  
  128. //Say('After Lon ' + AList.Text);
  129.  
  130.     ATag := ATif.GPSIFD.FindTag ($5);       // altref
  131.     AXmpParam := AXmp.XMPDesign.FindIdCommand ('exif', 'exif:GPSAltitudeRef', True);
  132.     HasXMP := False;
  133.     if AXmpParam <> nil then if (Nvl(AXmpParam.ParamContent, '') <> '') then
  134.       HasXMP := True;
  135.     if HasXMP then
  136.       begin AAltRef := StrToInt(AXmpParam.ParamContent); end
  137.     else if ATag <> nil then
  138.       begin AAltRef := ATag.Value; end
  139.     else
  140.       AAltRef := 0;
  141.  
  142.     ATag  := ATif.GPSIFD.FindTag ($6);        // alt
  143.     AXmpParam := AXmp.XMPDesign.FindIdCommand ('exif', 'exif:GPSAltitude', True);
  144.     HasXMP := False;
  145.     if AXmpParam <> nil then
  146.     begin
  147.       AAlt := 0;        // hvz; initialize the variable so the type is known
  148.       if AGps.XMPRat2Double(AXmpParam.ParamContent, AAlt) then
  149.       begin
  150.         if AAltRef <> 0 then AAlt := -AAlt;
  151.         HasXMP := True;
  152.       end;
  153.     end;
  154.     if HasXMP then
  155.     begin
  156.       UpdateNameValue(AList, 'Alt', StrTran (FloatToStr(AAlt), DecimalSeparator, '.'));
  157.     end
  158.     else if ATag <> nil then
  159.     begin
  160.       AAlt := ATag.Value;
  161.       if AAltRef <> 0 then AAlt := -AAlt;
  162.       UpdateNameValue(AList, 'Alt', StrTran (FloatToStr(AAlt), DecimalSeparator, '.'));
  163.     end;
  164.  
  165. //Say('After Alt ' + AList.Text);
  166.  
  167.     AXmpParam := AXmp.XMPDesign.FindIdCommand ('Iptc4xmpCore', 'Iptc4xmpCore:Location', True);
  168.     if (AXmpParam <> nil) then if (Nvl(AXmpParam.ParamContent, '') <> '') then
  169.       UpdateNameValue(AList, 'Location', AXmpParam.ParamContent);
  170.  
  171. //Say('After Location ' + AList.Text);
  172.  
  173.     AXmpParam := AXmp.XMPDesign.FindIdCommand ('photoshop', 'photoshop:City', True);
  174.     if (AXmpParam <> nil) then if (Nvl(AXmpParam.ParamContent, '') <> '') then
  175.       UpdateNameValue(AList, 'City', AXmpParam.ParamContent);
  176.  
  177. //Say('After City ' + AList.Text);
  178.  
  179.     AXmpParam := AXmp.XMPDesign.FindIdCommand ('photoshop', 'photoshop:State', True);
  180.     if (AXmpParam <> nil) then if (Nvl(AXmpParam.ParamContent, '') <> '') then
  181.       UpdateNameValue(AList, 'State', AXmpParam.ParamContent);
  182.  
  183. //Say('After State ' + AList.Text);
  184.  
  185.     AXmpParam := AXmp.XMPDesign.FindIdCommand ('photoshop', 'photoshop:Country', True);
  186.     if (AXmpParam <> nil) then if (Nvl(AXmpParam.ParamContent, '') <> '') then
  187.       UpdateNameValue(AList, 'Country', AXmpParam.ParamContent);
  188.  
  189. //Say('After Country ' + AList.Text);
  190.  
  191.     AXmpParam := AXmp.XMPDesign.FindIdCommand ('Iptc4xmpCore', 'Iptc4xmpCore:CountryCode', True);
  192.     if (AXmpParam <> nil) then if (Nvl(AXmpParam.ParamContent, '') <> '') then
  193.       UpdateNameValue(AList, 'Code', AXmpParam.ParamContent);
  194.  
  195. //Say('After Code ' + AList.Text);
  196.  
  197.   finally
  198.     ATif.Free;
  199.     AXmp.Free;
  200.   end; // try
  201. end;
  202.  
  203. procedure CleanupFiles (AFolder: WideString);
  204. var
  205.   AFiles: TTntStringList;
  206.   i: Integer;
  207. begin
  208.   AFiles := TTntStringList.Create;
  209.   SearchFolder (AFolder, cFilePrefixID + '*.*', 0, AFiles, False, -1);
  210.  
  211.   for i := 0 to AFiles.Count - 1 do
  212.   begin
  213.     //Say (AFiles.Strings[i]);
  214.     WideDeleteFile (AFiles.Strings[i]);
  215.   end;
  216.  
  217.   AFiles.Free;
  218. end;
  219.  
  220. procedure Initialize;    // use this procedure for global initialization
  221. var
  222.   scriptObject: OleVariant;
  223.   strGEVersion: String;
  224.   strKMLPath: WideString;
  225.   strKMLFile: WideString;
  226.   strThumbFile: WideString; { path + filename }
  227.   strThumbFileShort: WideString; { filename }
  228.   strGPSLatitude: String;
  229.   strGPSLongitude: String;
  230.   AFile: TTntStringList;
  231.   AList: TStringList;
  232.   AStr , AName: WideString;
  233.   IsOk: Boolean;
  234.   ItemCounter: Integer;
  235.   ItemsWritten : Integer;
  236.   FileDateTimeStr,  { for filename }
  237.   FolderDateTimeStr : String; { for KML folder description }
  238.   ADateTime : TDateTime;
  239.  
  240. begin
  241.   AGps := TGPSReadWrite.Create;
  242.  
  243.   scriptObject         := CreateOleObject ('WScript.Shell');
  244.   strGEVersion         := scriptObject.RegRead('HKCU\Software\Google\Google Earth Plus\autoupdate\InstalledVersion');
  245.   //strKMLPath           := scriptObject.SpecialFolders('MyDocuments') + '\';
  246.   strKMLPath           := WideIncludeTrailingBackslash (WindowsTempDir);
  247.   scriptObject         := nil;
  248.  
  249.   CleanupFiles (strKMLPath);
  250.  
  251.   // Check if Google Earth is installed
  252.   if strGEVersion = '' then
  253.   begin
  254.     Say ('Google Earth is not installed.');
  255.     exit;
  256.   end;
  257.  
  258.   // Check that at least 1 image is selected
  259.   if Selected.Count < 1 then
  260.   begin
  261.     Say ('Please select at least 1 image.');
  262.     exit;
  263.   end;
  264.  
  265.   // Construct date/time strings
  266.   ADateTime := Now;
  267.   FileDateTimeStr   := FormattedDateTime('yyyymmdd-hhnnss', ADateTime);
  268.   FolderDateTimeStr := DateTimeToStr(ADateTime); { should result in localised formatting }
  269.  
  270.   // Create KML string
  271.   // NOTE: Would be preferable to use an XML parser here
  272.   //       instead of just stringing a text file
  273.   AFile := TTntStringList.Create;
  274.   AFile.Add ('<?xml version="1.0" encoding="UTF-8"?>');
  275.   AFile.Add ('<kml xmlns="http://earth.google.com/kml/2.2">')
  276.   AFile.Add('<Folder>')
  277.   AFile.Add('<name>IDImager</name>')
  278.   AFile.Add('<description>Created by IDImager on ' + FolderDateTimeStr + '</description>');
  279.   AFile.Add('<open>1</open>')
  280.  
  281.   // Loop through selected thumbs
  282.   ItemsWritten := 0;
  283.   for ItemCounter := 0 to Selected.Count - 1 do
  284.   begin
  285.  
  286.     AList := TStringList.Create;
  287.     ReadImageInfo(Selected.Items[ItemCounter], AList);
  288.  
  289.     // Check that coordinates were retrieved
  290.     if not ((AList.IndexOfName('Lat') < 0) or (AList.IndexOfName('Lon') < 0)) then
  291.     begin
  292.  
  293.       ItemsWritten := ItemsWritten + 1;
  294.  
  295.       // Retrieve GPS coordinates
  296.       strGPSLongitude := AList.Values['Lon'];
  297.       strGPSLatitude  := AList.Values['Lat'];
  298.  
  299.       // determine description: try description, headline, title and ImageName (in that order).
  300.       // Can if-construct below be made a bit more elegant?
  301.       AStr := toWideString('');
  302.       IsOK := Catalog.FindXMPCachedTagValueForImage (Selected.Items[ItemCounter], 'dc:description', AStr);
  303.       if AStr = '' then
  304.         IsOK := Catalog.FindXMPCachedTagValueForImage (Selected.Items[ItemCounter], 'photoshop:headline', AStr);
  305.       if AStr = '' then
  306.         IsOK := Catalog.FindXMPCachedTagValueForImage (Selected.Items[ItemCounter], 'dc:title', AStr);
  307.       if AStr = '' then
  308.         AStr := Selected.Items[ItemCounter].ImageName;
  309.  
  310.       AName := '';     
  311.       Catalog.FindXMPCachedTagValueForImage (Selected.Items[ItemCounter], 'photoshop:headline', AName);
  312.       if AName = '' then
  313.         Catalog.FindXMPCachedTagValueForImage (Selected.Items[ItemCounter], 'dc:title', AName);
  314.       if AName = '' then
  315.         AName := Selected.Items[ItemCounter].FileNameOnly;
  316.  
  317.       // Create thumbs file using GUID (delete existing)
  318.       strThumbFileShort := cFilePrefixID + Selected.Items[ItemCounter].GUID + '.thumb';
  319.       strThumbFile := strKMLPath + strThumbFileShort;
  320.       if WideFileExists (strThumbFile) then
  321.         WideDeleteFile (strThumbFile);
  322.  
  323.       AFile.Add ('  <Placemark>');
  324.       AFile.Add ('    <name>' + AName + '</name>');
  325.  
  326.       if Selected.Items[ItemCounter].HasThumb then
  327.       begin
  328.         // Create thumb file
  329.         Selected.Items[ItemCounter].ThumbStream.SaveToFile (strThumbFile);
  330.  
  331.         // don't use path in img src
  332.         AFile.Add ('    <description><![CDATA[<img src="' + strThumbFileShort + '"><br/>' + AStr + '<br/>]]></description>');
  333.       end
  334.       else
  335.         AFile.Add ('    <description><![CDATA[' + AStr + '<br/>]]></description>');
  336.  
  337.       AFile.Add ('    <Point>');
  338.       AFile.Add ('      <coordinates>' + strGPSLongitude + ',' + strGPSLatitude + ',0</coordinates>');
  339.       AFile.Add ('    </Point>');
  340.       AFile.Add ('  </Placemark>');
  341.     end; { if gps data present }
  342.  
  343.     // clear image info
  344.     AList.Free;
  345.  
  346.   end; { for }
  347.  
  348.   if ItemsWritten = 0 then
  349.     Say('No GPS data present in any of the images')
  350.   else
  351.   begin
  352.     // Finish KML string
  353.     AFile.Add('</Folder>')
  354.     AFile.Add ('</kml>');
  355.  
  356.     // Create and write KML file (delete existing)
  357.     //strKMLFile := strKMLPath + cFilePrefixID + 'idimager-' + FileDateTimeStr + '.kml';
  358.     strKMLFile := strKMLPath + cFilePrefixID + 'idimager.kml';
  359.     if WideFileExists (strKMLFile) then
  360.       WideDeleteFile (strKMLFile);
  361.     AFile.AnsiStrings.SaveToFile (strKMLFile);        // save as UTF-8
  362.  
  363.     // Open KML file (and Google Earth via association)
  364.     ShellDoExecute (nil, strKMLFile);
  365.   end;
  366.  
  367.   // Tidy up
  368.   AFile.Free;
  369. end;
  370.  
  371. procedure Finalize;      // use this procedure for global finalization
  372. begin
  373.   AGps.Free;
  374. end;
  375.